home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0022_Randmom Number Function.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-16  |  2KB  |  54 lines
  1. ===========================================================================
  2.  BBS: Canada Remote Systems
  3. Date: 06-18-93 (23:27)             Number: 26893
  4. From: KENT BRIGGS                  Refer#: NONE
  5.   To: BRIAN PAPE                    Recvd: NO  
  6. Subj: RANDOM NUMBERS                 Conf: (1221) F-PASCAL
  7. ---------------------------------------------------------------------------
  8.  -=> Quoting Brian Pape to Erik Johnson <=-
  9.  
  10.  BP> Please- I *am* looking for the source code to a decent random number
  11.  BP> generator so that I'm not dependant on Borland.
  12.  
  13.  Brian, Borland did change their random:word function when they released
  14.  7.0.  However the random:real function, the randomize procedure, and their
  15.  method of updating randseed remain the same as ver 6.0.  Using DJ Murdoch's
  16.  CycleRandseed procedure and reverse engineering TP6's and TP7's Random
  17.  functions, I came up with the following routines:
  18.  
  19. const rseed: longint = 0;
  20.  
  21. procedure randomize67;      {TP 6.0 & 7.0 seed generator}
  22. begin
  23.   reg.ah:=$2c;
  24.   msdos(reg);    {get time: ch=hour,cl=min,dh=sec,dl=sec/100}
  25.   rseed:=reg.dx;
  26.   rseed:=(rseed shl 16) or reg.cx;
  27. end;
  28.  
  29. function rand_word6(x: word): word;    {TP 6.0 RNG: word}
  30. begin
  31.   rseed:=rseed*134775813+1;
  32.   rand_word6:=(rseed shr 16) mod x;
  33. end;
  34.  
  35. function rand_word7(x: word): word;    {TP 7.0 RNG: word}
  36. begin
  37.   rseed:=rseed*134775813+1;
  38.   rand_word7:=((rseed shr 16)*x+((rseed and $ffff)*x shr 16)) shr 16;
  39. end;
  40.  
  41. function rand_real67: real;    {TP 6.0 & 7.0 RNG: real}
  42. begin
  43.   rseed:=rseed*134775813+1;
  44.   if rseed<0 then rand_real67:=rseed/4294967296.0+1.0 else
  45.   rand_real67:=rseed/4294967296.0;
  46. end;
  47.  
  48. If anyone can improve on these please post some code here, thanks.
  49.  
  50. ___ Blue Wave/QWK v2.12
  51. --- Renegade v06-11 Beta
  52.  
  53.  * Origin: Snipe's Castle BBS, Waco TX   (817)-757-0169 (1:388/26)
  54.